Datos de observaciones actuales
ruta_productos <- "C:\\Users\\Usuario\\Downloads\\ARCHIVOS DE POSIT\\PRODUCTOS_2025.xlsx"
#"/cloud/project/PRODUCTOS_2025.xlsx"
excel_sheets(ruta_productos)
## [1] "Sheet 1"
Productos2025 <- as.data.frame(read_xlsx(ruta_productos, sheet ="Sheet 1"))
Productos2025$Mes <- format(Productos2025$Fecha, format ="%Y-%m")
Fecha2025 <- Productos2025$Fecha
Productos2025 <- Productos2025 %>%
group_by(Fecha = as.Date(Fecha)) %>%
summarize(Totales = sum(Totales),
.groups = "keep")
head(Productos2025)
## # A tibble: 6 × 2
## # Groups: Fecha [6]
## Fecha Totales
## <date> <dbl>
## 1 2024-12-07 2926.
## 2 2025-01-03 2466.
## 3 2025-01-08 1672.
## 4 2025-01-09 7273.
## 5 2025-01-10 20880
## 6 2025-01-11 8352
tail(Productos2025)
## # A tibble: 6 × 2
## # Groups: Fecha [6]
## Fecha Totales
## <date> <dbl>
## 1 2025-02-24 14240.
## 2 2025-02-27 20630.
## 3 2025-03-06 66800.
## 4 2025-03-31 42850.
## 5 2025-04-08 4749.
## 6 2025-04-16 923.
nrow(Productos2025)
## [1] 32
Series
productoss_2025_ts <- ts(Productos2025$Totales,start =1, frequency =1)
productoss_2025_xts <- as.xts(productoss_2025_ts)
Gráfica de las serie

Datos historicos de productos 2019-2024
ruta <- "C:\\Users\\Usuario\\Downloads\\ARCHIVOS DE POSIT\\Ventas_Suministros_Totales.xlsx"
excel_sheets(ruta)
## [1] "Ventas Totales Original" "Servicios Totales Original"
# "Ventas Totales Original" "Servicios Totales Original"
Productos_Totales <- as.data.frame(read_xlsx(ruta,
sheet = "Ventas Totales Original"))
Productos_Totales$Semana <- format(Productos_Totales$Fecha, format = "%Y-%U")
Productos_Totales$mes <- format(Productos_Totales$Fecha, format = "%Y-%m")
head(Productos_Totales)
## Folio Fecha RFC Empresa
## 1 1 2019-07-01 10:01:03 VEPS740807T84 Silvia Elena Velasco Palacios
## 2 2 2019-07-01 11:40:32 CERI890615EU1 ISRAEL CETINA ROSALES
## 3 2 2019-07-01 11:40:32 CERI890615EU1 ISRAEL CETINA ROSALES
## 4 2 2019-07-01 11:40:32 CERI890615EU1 ISRAEL CETINA ROSALES
## 5 2 2019-07-01 11:40:32 CERI890615EU1 ISRAEL CETINA ROSALES
## 6 2 2019-07-01 11:40:32 CERI890615EU1 ISRAEL CETINA ROSALES
## Cantidad Unidad
## 1 1 Bidón de plástico
## 2 1 Pieza
## 3 1 Pieza
## 4 1 Pieza
## 5 1 Pieza
## 6 1 Pieza
## Descripcion ValorUnitario
## 1 Algicin marca Spin en presentación de garrafa de 20 Litros 700.00
## 2 Kit de Sello y espaciadores Piston Superior 308.04
## 3 Kit de sello y espaciadores Piston Inferior 811.78
## 4 Kit Piston Superior 9000/9100 968.58
## 5 Kit Piston Inferior 9000/9100 1784.38
## 6 Engrane motriz Inferior 9100 1092.00
## Total Semana mes
## 1 812.0000 2019-26 2019-07
## 2 357.3264 2019-26 2019-07
## 3 941.6648 2019-26 2019-07
## 4 1123.5528 2019-26 2019-07
## 5 2069.8808 2019-26 2019-07
## 6 1266.7200 2019-26 2019-07
nrow(Productos_Totales)
## [1] 1995
productos <- data.frame(Fecha = Productos_Totales$Fecha, Totales = Productos_Totales$Total)
Suma de historicos
productos <- productos %>%
group_by(Fecha = as.Date(Fecha)) %>%
summarize(Totales = sum(Totales),
.groups = "keep")
head(productos)
## # A tibble: 6 × 2
## # Groups: Fecha [6]
## Fecha Totales
## <date> <dbl>
## 1 2019-07-01 25826.
## 2 2019-07-03 3138.
## 3 2019-07-04 5330.
## 4 2019-07-05 10146.
## 5 2019-07-06 10962
## 6 2019-07-08 16194.
nrow(productos)
## [1] 695
Serie
productos_ts <- ts(productos$Totales, start = 1, frequency = 1)
Union de los datos
PRODTOTAL <- merge(x = productos, y = Productos2025, all = T)
head(PRODTOTAL)
## Fecha Totales
## 1 2019-07-01 25826.333
## 2 2019-07-03 3137.800
## 3 2019-07-04 5329.713
## 4 2019-07-05 10145.534
## 5 2019-07-06 10962.000
## 6 2019-07-08 16193.600
tail(PRODTOTAL)
## Fecha Totales
## 722 2025-02-24 14240.16
## 723 2025-02-27 20630.00
## 724 2025-03-06 66799.76
## 725 2025-03-31 42850.40
## 726 2025-04-08 4749.04
## 727 2025-04-16 923.36
nrow(PRODTOTAL)
## [1] 727
Serie mensual
prodmes_ts <- ts(PRODTOTAL$Totales, start = c(2019,07,01),
end = c(2025,04,16),frequency = 12)
prodmes_ts
## Jan Feb Mar Apr May Jun
## 2019
## 2020 5476.894 3264.820 2591.452 1604.837 8224.783 6308.544
## 2021 1021.890 1271.894 2621.600 232.000 1021.890 21133.042
## 2022 1024.930 1765.334 2408.427 4415.981 15757.660 25711.017
## 2023 5909.272 10100.445 3357.922 1049.348 17229.480 6295.042
## 2024 285984.952 34886.165 10962.000 18731.030 4778.272 2925.520
## 2025 22960.483 9231.744 10499.763 13336.787
## Jul Aug Sep Oct Nov Dec
## 2019 25826.333 3137.800 5329.713 10145.534 10962.000 16193.600
## 2020 4048.400 11098.950 2992.800 23387.062 4384.800 2259.402
## 2021 8769.600 1851.360 8769.600 3966.040 23594.400 7424.000
## 2022 20318.131 6322.000 2009.468 35523.562 20083.811 8769.600
## 2023 3853.497 2204.000 2273.600 16639.040 13033.760 2817.895
## 2024 21151.579 4162.451 25828.699 6090.000 60236.654 1921.482
## 2025
length(prodmes_ts)
## [1] 70
# 70 - 4 meses de 2025 = 66 de 2019-2024
#Fecha final de historicos
Serie mensual con boxcox
serie_mensual_prod <- ts(PM, start = 1, frequency = 1)
Grafica mensual
ts_plot(serie_mensual_prod, color = "blue", Xtitle = "Meses", Ytitle = "Valores",
title = " Serie mensual de productos")
Diferenciar
ndiffs(serie_mensual_prod[1:66])
## [1] 0
ACF y PACF
ggAcf(serie_mensual_prod[1:66], col = "red", lwd = 2, lag.max = 50)

ggPacf(serie_mensual_prod[1:66], col = "blue", lwd = 2, lag.max = 50)

Modelo
ARIMA_PM <- auto.arima(y = serie_mensual_prod[1:66], stationary = F, seasonal = F, stepwise = F, trace = T)
##
## ARIMA(0,0,0) with zero mean : 458.0487
## ARIMA(0,0,0) with non-zero mean : 176.2192
## ARIMA(0,0,1) with zero mean : 382.9475
## ARIMA(0,0,1) with non-zero mean : 175.8488
## ARIMA(0,0,2) with zero mean : 339.4598
## ARIMA(0,0,2) with non-zero mean : 177.993
## ARIMA(0,0,3) with zero mean : 309.9792
## ARIMA(0,0,3) with non-zero mean : 179.6661
## ARIMA(0,0,4) with zero mean : 292.3764
## ARIMA(0,0,4) with non-zero mean : 182.0679
## ARIMA(0,0,5) with zero mean : 281.003
## ARIMA(0,0,5) with non-zero mean : 184.5604
## ARIMA(1,0,0) with zero mean : 210.1503
## ARIMA(1,0,0) with non-zero mean : 175.6345
## ARIMA(1,0,1) with zero mean : Inf
## ARIMA(1,0,1) with non-zero mean : 177.6986
## ARIMA(1,0,2) with zero mean : Inf
## ARIMA(1,0,2) with non-zero mean : 180.0209
## ARIMA(1,0,3) with zero mean : Inf
## ARIMA(1,0,3) with non-zero mean : 182.0722
## ARIMA(1,0,4) with zero mean : Inf
## ARIMA(1,0,4) with non-zero mean : 183.7953
## ARIMA(2,0,0) with zero mean : Inf
## ARIMA(2,0,0) with non-zero mean : 177.7984
## ARIMA(2,0,1) with zero mean : Inf
## ARIMA(2,0,1) with non-zero mean : 180.0297
## ARIMA(2,0,2) with zero mean : Inf
## ARIMA(2,0,2) with non-zero mean : 182.3055
## ARIMA(2,0,3) with zero mean : Inf
## ARIMA(2,0,3) with non-zero mean : Inf
## ARIMA(3,0,0) with zero mean : Inf
## ARIMA(3,0,0) with non-zero mean : 179.7691
## ARIMA(3,0,1) with zero mean : Inf
## ARIMA(3,0,1) with non-zero mean : 182.1048
## ARIMA(3,0,2) with zero mean : Inf
## ARIMA(3,0,2) with non-zero mean : Inf
## ARIMA(4,0,0) with zero mean : Inf
## ARIMA(4,0,0) with non-zero mean : 182.0962
## ARIMA(4,0,1) with zero mean : Inf
## ARIMA(4,0,1) with non-zero mean : 184.5791
## ARIMA(5,0,0) with zero mean : Inf
## ARIMA(5,0,0) with non-zero mean : 184.6027
##
##
##
## Best model: ARIMA(1,0,0) with non-zero mean
summary(ARIMA_PM)
## Series: serie_mensual_prod[1:66]
## ARIMA(1,0,0) with non-zero mean
##
## Coefficients:
## ar1 mean
## 0.2054 7.6048
## s.e. 0.1217 0.1345
##
## sigma^2 = 0.784: log likelihood = -84.62
## AIC=175.25 AICc=175.63 BIC=181.82
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set -0.00366912 0.8718936 0.7001175 -1.408411 9.401275 0.7716353
## ACF1
## Training set -0.009499828
Residuales
checkresiduals(ARIMA_PM, col = "darkgreen")

##
## Ljung-Box test
##
## data: Residuals from ARIMA(1,0,0) with non-zero mean
## Q* = 3.4953, df = 9, p-value = 0.9414
##
## Model df: 1. Total lags used: 10
# p-value = 0.9414
Criterio AIC
AIC(ARIMA_PM)
## [1] 175.2474
# [1] 175.2474
Pronóstico
pron <- forecast(object = ARIMA_PM, h = length(serie_mensual_prod[67:70]), level = 0.95)
summary(pron)
##
## Forecast method: ARIMA(1,0,0) with non-zero mean
##
## Model Information:
## Series: serie_mensual_prod[1:66]
## ARIMA(1,0,0) with non-zero mean
##
## Coefficients:
## ar1 mean
## 0.2054 7.6048
## s.e. 0.1217 0.1345
##
## sigma^2 = 0.784: log likelihood = -84.62
## AIC=175.25 AICc=175.63 BIC=181.82
##
## Error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set -0.00366912 0.8718936 0.7001175 -1.408411 9.401275 0.7716353
## ACF1
## Training set -0.009499828
##
## Forecasts:
## Point Forecast Lo 95 Hi 95
## 67 7.422243 5.686867 9.157619
## 68 7.567314 5.795725 9.338902
## 69 7.597104 5.824005 9.370204
## 70 7.603222 5.830059 9.376385
pron <- data.frame(pronosticos = pron, actuales = as.numeric(serie_mensual_prod[67:70]))
colnames(pron) <- c("pronosticos", "Limite_inf", "Limite_sup", "actuales")
head(pron)
## pronosticos Limite_inf Limite_sup actuales
## 67 7.422243 5.686867 9.157619 8.588141
## 68 7.567314 5.795725 9.338902 7.917654
## 69 7.597104 5.824005 9.370204 8.013556
## 70 7.603222 5.830059 9.376385 8.190726
tail(pron)
## pronosticos Limite_inf Limite_sup actuales
## 67 7.422243 5.686867 9.157619 8.588141
## 68 7.567314 5.795725 9.338902 7.917654
## 69 7.597104 5.824005 9.370204 8.013556
## 70 7.603222 5.830059 9.376385 8.190726
nrow(pron)
## [1] 4
Exactitud
accuracy(pron$pronosticos, serie_mensual_prod[67:70])
## ME RMSE MAE MPE MAPE
## Test set 0.6300487 0.7072218 0.6300487 7.59253 7.59253
Gráficas de los pronósticos

Inverso de Boxcox
valores_reales <- InvBoxCox(x = pron, lambda = -0.03199604)
valores_reales
## pronosticos Limite_inf Limite_sup actuales
## 67 4787.915 532.2146 50859.29 22960.485
## 68 5794.615 608.1385 65794.44 9231.745
## 69 6027.076 629.6348 68800.28 10499.764
## 70 6075.992 634.3376 69410.43 13336.788
Gráfica de los valores

Excactitud real
accuracy(valores_reales$pronosticos,valores_reales$actuales)
## ME RMSE MAE MPE MAPE
## Test set 8335.796 10183.08 8335.796 53.35466 53.35466